home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / diagramf / arrows.mf < prev    next >
Text File  |  1993-01-11  |  7KB  |  189 lines
  1. %%% ====================================================================
  2. %%%  @METAFONT-file{
  3. %%%     author          = "Alan Jeffrey",
  4. %%%     version         = "1.1",
  5. %%%     date            = "02 June 1992",
  6. %%%     time            = "13:26:18 BST",
  7. %%%     filename        = "arrows.mf",
  8. %%%     address         = "School of Cognitive and Computing Sciences
  9. %%%                        University of Sussex
  10. %%%                        Brighton BN1 9QH
  11. %%%                        UK",
  12. %%%     telephone       = "+44 273 606755 x 3238",
  13. %%%     FAX             = "+44 273 678188",
  14. %%%     checksum        = "02505 188 855 6803",
  15. %%%     email           = "alanje@cogs.sussex.ac.uk",
  16. %%%     codetable       = "ISO/ASCII",
  17. %%%     keywords        = "diagrams, metafont, arrows",
  18. %%%     supported       = "yes",
  19. %%%     abstract        = "This is a metafont program which provides
  20. %%%                        commands for drawing arrows",
  21. %%%     docstring       = "This is part of the diagramf package which
  22. %%%                        interfaces TeX and metafont.  It is
  23. %%%                        described in diagramf.tex.
  24. %%%
  25. %%%                        Copyright 1992 Alan Jeffrey.
  26. %%%
  27. %%%                        The checksum field above contains a CRC-16
  28. %%%                        checksum as the first value, followed by the
  29. %%%                        equivalent of the standard UNIX wc (word
  30. %%%                        count) utility output of lines, words, and
  31. %%%                        characters.  This is produced by Robert
  32. %%%                        Solovay's checksum utility.",
  33. %%%     package         = "diagramf",
  34. %%%     dependencies    = "none",
  35. %%%     maintainer      = "Jeremy Gibbons",
  36. %%%     address-maintainer = "Department of Computer Science
  37. %%%                        University of Aukland
  38. %%%                        Private Bag
  39. %%%                        Aukland
  40. %%%                        New Zealand",
  41. %%%     email-maintainer = "jeremy@cs.aukuni.ac.nz",
  42. %%%  }
  43. %%% ====================================================================
  44. %%%
  45. %%% 25 Oct 1990, v1.0: Released version 1.0.
  46. %%%
  47. %%% 2 Jun 1992, v1.1: Added standard headers.
  48.  
  49. % This program draws arrows---if you say drawarrow p, where p is a
  50. % path, you get p drawn with an arrowhead at the end.  Actually, you
  51. % don't quite get p, as we have to chop a bit off the end, so you get
  52. %
  53. %        *
  54. %         *
  55. %     ******
  56. %     *******
  57. %     ******
  58. %         *
  59. %        *
  60. %
  61. % rather than
  62. %
  63. %        *
  64. %         *
  65. %     *******
  66. %     *******
  67. %     *******
  68. %         *
  69. %        *
  70. %
  71. % Also the path gets straightened out a bit, so paths which end in
  72. % very tight curves usually get drawn OK.
  73. %
  74. % The parameters we need are
  75. %
  76. %    arrowheadcrisp    --- the value of crisp (see cmbase) for arrowheads,
  77. %    arrowheadheight   --- the height of an arrowhead facing right,
  78. %    arrowheadwidth    --- the width of an arrowhead facing right,
  79. %    arrowheadstraight --- the straightness of an arrowhead (from 0 to 1),
  80. %    arrowheadline     --- the width of line an arrowhead is drawn with.
  81. %    arrowpathstraight --- the length of the straight bit added to a path, and
  82. %
  83. % Their default values are ripped off from cmr10 (apart from
  84. % arrowpathstraight, which I just guesstimated).
  85.  
  86. if unknown arrowheadcrisp:    arrowheadcrisp    := 0pt;              fi
  87. if unknown arrowheadheight:   arrowheadheight   := 120/36pt;         fi
  88. if unknown arrowheadwidth:    arrowheadwidth    := 60/36pt;          fi
  89. if unknown arrowheadstraight: arrowheadstraight := .381966;          fi
  90. if unknown arrowheadline:     arrowheadline     := 11/36pt;          fi
  91. if unknown arrowpathstraight: arrowpathstraight := 2.5arrowheadline; fi
  92.  
  93. % To begin with, a couple of path intersectors --- p joinedpath q
  94. % draws p until it intersects with q, then draws the rest of q.
  95.  
  96. tertiarydef p joinedpath q =
  97.     begingroup
  98.         numeric t,u;
  99.         (t,u) = p intersectiontimes q;
  100.         (subpath (0,t) of p) .. (subpath (u,infinity) of q)
  101.     endgroup
  102. enddef;
  103.  
  104. % And p uptopath q is p until in intersects with q.
  105.  
  106. tertiarydef p uptopath q =
  107.     subpath (0, xpart (p intersectiontimes q)) of p
  108. enddef;
  109.  
  110. % And a declaration localpen that saves all the variables associated
  111. % with the current pen, and gives you fresh ones to play with.
  112.  
  113. def localpen =
  114.     interim pen_lft:=0;
  115.     interim pen_rt:=0;
  116.     interim pen_top:=0;
  117.     interim pen_bot:=0;
  118.     interim currentbreadth:=0;
  119.     save currentpen, currentpen_path;
  120.     pen currentpen;
  121.     path currentpen_path;
  122. enddef;
  123.  
  124. % pos is nicked from cmbase.
  125.  
  126. newinternal currentbreadth;
  127. vardef pos@#(expr b,d) =
  128.  if known b: if b<=currentbreadth: errmessage "bad pos"; fi fi
  129.  (x@#r-x@#l,y@#r-y@#l)=(b-currentbreadth,0) rotated d;
  130.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  131. def numeric_pickup_ primary q =
  132.  currentpen:=pen_[q];
  133.  pen_lft:=pen_lft_[q];  pen_rt:=pen_rt_[q];
  134.  pen_top:=pen_top_[q];  pen_bot:=pen_bot_[q];
  135.  currentpen_path:=pen_path_[q];
  136.  if known breadth_[q]: currentbreadth:=breadth_[q]; fi enddef;
  137.  
  138. % And arrowheadcrisp.nib is just a scaled pencircle.
  139.  
  140. pickup pencircle scaled arrowheadcrisp;
  141. arrowheadcrisp.nib := savepen;
  142.  
  143. % We can now draw an unstraightened arrow.  This is just ripped off
  144. % from the cmr symbol font.
  145.  
  146. def drawunstraightenedarrow expr p =
  147.     begingroup;
  148.        save x, y, theta;
  149.        theta = angle (direction (length p) of p);
  150.        begingroup
  151.            localpen;
  152.            pickup arrowheadcrisp.nib;
  153.            z0 = point (length p) of p;
  154.            pos3 (arrowheadline,theta+180);
  155.            pos4 (arrowheadline,theta+180);
  156.            z3 = z0 + (-arrowheadwidth,.5arrowheadheight) rotated theta;
  157.            z4 = z0 + (-arrowheadwidth,-.5arrowheadheight) rotated theta;
  158.            pos5 (arrowheadline,angle(z3-z0));
  159.            pos6 (arrowheadline,angle(z4-z0));
  160.            z5l = z6l = z0;
  161.            z9 = arrowheadstraight[.5[z3,z4],z0];
  162.            filldraw (z5l..z4l{z4-z9})
  163.                     -- ((z4r{z9-z4}..z5r) joinedpath (z6r..z3r{z3-z9}))
  164.                     -- (z3l{z9-z3}..z6l)
  165.                     -- cycle;
  166.        endgroup;
  167.        draw p uptopath (z4r{z9-z4}..z5r);
  168.     endgroup;
  169. enddef;
  170.  
  171. % We then straighten a path by taking the last section of it, keeping
  172. % its control points, but moving the last point back by
  173. % arrowpathstraight, and putting in a straight line at the end.
  174.  
  175. def straightenpath expr p =
  176.     subpath (0,length p - 1) of p
  177.        .. controls (postcontrol (length p - 1) of p)
  178.                and (precontrol (length p) of p)
  179.        .. arrowpathstraight
  180.               * (unitvector (- (direction (length p) of p)))
  181.               + (point (length p) of p)
  182.        -- point (length p) of p
  183. enddef;
  184.  
  185. % Finally, we draw an arrow as an unstraightened arrow of a
  186. % straightened path.
  187.  
  188. def drawarrow = drawunstraightenedarrow straightenpath enddef;
  189.